The United States Census Bureau’s International Dataset estimates of countries life expectancies. The dataset contains 228 countries’ life expectancy over the years between 1979 and 2050. It includes 15,106 rows and 15 columns. There are mainly numerical information in dataset such as; infant mortality and life expectancy. These information are categorized into country, year and gender.
Furthermore, our dataset contains country’s surface area and population information. We would like to draw a world map and see the population change for the countries over the years.
Finally, we would like to compare our findings from life expectancy & population information with income levels of OECD countries.
In our project we would like to do;
Our tentative plan is as below;
getwd()
## [1] "C:/Users/yigit.hakan/Downloads"
library(tidyverse)
## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr
## Conflicts with tidy packages ----------------------------------------------
## filter(): dplyr, stats
## lag(): dplyr, stats
library(purrr)
library(leaflet)
## Warning: package 'leaflet' was built under R version 3.4.3
library(maps)
## Warning: package 'maps' was built under R version 3.4.3
##
## Attaching package: 'maps'
## The following object is masked from 'package:purrr':
##
## map
library(tidyverse)
library(dplyr)
library(sp)
## Warning: package 'sp' was built under R version 3.4.3
library(maptools)
## Warning: package 'maptools' was built under R version 3.4.3
## Checking rgeos availability: TRUE
# Load the data
mortality <- read.csv("mortality_life_expectancy.csv")
# lets see how our data looks like by glimpse function.
glimpse(mortality)
## Observations: 15,106
## Variables: 15
## $ ï..country_code <fctr> SI, SI, SI, SI, SI, SI, SI, SI, ...
## $ country_name <fctr> Slovenia, Slovenia, Slovenia, Sl...
## $ year <int> 2036, 2022, 2023, 2024, 2025, 202...
## $ infant_mortality <dbl> 3.39, 3.76, 3.73, 3.70, 3.67, 3.6...
## $ infant_mortality_male <dbl> 3.76, 4.22, 4.18, 4.14, 4.10, 4.0...
## $ infant_mortality_female <dbl> 3.00, 3.27, 3.25, 3.22, 3.20, 3.1...
## $ life_expectancy <dbl> 80.90, 79.11, 79.26, 79.40, 79.55...
## $ life_expectancy_male <dbl> 77.51, 75.58, 75.73, 75.89, 76.04...
## $ life_expectancy_female <dbl> 84.52, 82.89, 83.02, 83.15, 83.29...
## $ mortality_rate_under5 <dbl> 3.93, 4.43, 4.39, 4.35, 4.31, 4.2...
## $ mortality_rate_under5_male <dbl> 4.39, 5.02, 4.97, 4.91, 4.86, 4.8...
## $ mortality_rate_under5_female <dbl> 3.44, 3.81, 3.78, 3.74, 3.71, 3.6...
## $ mortality_rate_1to4 <dbl> 0.54, 0.68, 0.67, 0.65, 0.64, 0.6...
## $ mortality_rate_1to4_male <dbl> 0.63, 0.80, 0.79, 0.77, 0.76, 0.7...
## $ mortality_rate_1to4_female <dbl> 0.44, 0.54, 0.53, 0.52, 0.51, 0.5...
summary(mortality)
## ï..country_code country_name year infant_mortality
## BT : 101 Bhutan : 101 Min. :1950 Min. : 1.15
## DJ : 101 Djibouti: 101 1st Qu.:2001 1st Qu.: 5.83
## NI : 98 Nigeria : 98 Median :2017 Median : 14.06
## GV : 96 Guinea : 96 Mean :2017 Mean : 29.68
## CB : 89 Cambodia: 89 3rd Qu.:2034 3rd Qu.: 38.77
## CD : 87 Chad : 87 Max. :2050 Max. :298.30
## (Other):14534 (Other) :14534
## infant_mortality_male infant_mortality_female life_expectancy
## Min. : 0.22 Min. : 0.73 Min. :10.01
## 1st Qu.: 6.37 1st Qu.: 5.17 1st Qu.:66.27
## Median : 15.68 Median : 12.34 Median :74.30
## Mean : 32.24 Mean : 27.02 Mean :71.31
## 3rd Qu.: 42.85 3rd Qu.: 34.55 3rd Qu.:79.34
## Max. :314.65 Max. :281.22 Max. :91.58
##
## life_expectancy_male life_expectancy_female mortality_rate_under5
## Min. : 9.82 Min. :10.21 Min. : 1.44
## 1st Qu.:63.77 1st Qu.:68.67 1st Qu.: 6.92
## Median :71.61 Median :77.18 Median : 17.05
## Mean :68.88 Mean :73.85 Mean : 43.18
## 3rd Qu.:76.60 3rd Qu.:82.32 3rd Qu.: 52.62
## Max. :88.69 Max. :94.97 Max. :455.12
##
## mortality_rate_under5_male mortality_rate_under5_female
## Min. : 1.66 Min. : 1.210
## 1st Qu.: 7.63 1st Qu.: 6.103
## Median : 19.11 Median : 15.030
## Mean : 46.13 Mean : 40.120
## 3rd Qu.: 57.40 3rd Qu.: 47.398
## Max. :466.23 Max. :443.650
##
## mortality_rate_1to4 mortality_rate_1to4_male mortality_rate_1to4_female
## Min. : 0.20 Min. : 0.21 Min. : 0.0000
## 1st Qu.: 1.01 1st Qu.: 1.13 1st Qu.: 0.8625
## Median : 2.90 Median : 3.23 Median : 2.5300
## Mean : 14.90 Mean : 15.41 Mean : 14.3698
## 3rd Qu.: 13.91 3rd Qu.: 14.91 3rd Qu.: 12.8375
## Max. :335.59 Max. :342.79 Max. :328.3100
##
#Mortality rate infants for male/ female
qplot(x = infant_mortality_male, y = infant_mortality_female, data = mortality)
#Mortality rate infants - 1970/2000/2017/2050
target <- c("1970", "2000", "2017", "2050")
years_chosen <- filter(mortality, year %in% target)
qplot(x = infant_mortality, y = year, data = years_chosen)
#Mortality rate infants - Turkey
mortality_turkey <- filter(mortality, country_name == "Turkey")
ggplot(aes(x = infant_mortality, y = year), data = mortality_turkey)+
geom_point()
#Life expectancy
qplot(x=life_expectancy, data=mortality, binwidth=5)
#Life expectancy male/female
ggplot(aes(x = life_expectancy_male, y = life_expectancy_female), data = mortality)+
geom_point()
#Life expectancy of Turkey
summary(mortality %>%
filter(country_name == "Turkey"))
## ï..country_code country_name year infant_mortality
## TU :71 Turkey :71 Min. :1980 Min. : 6.63
## AA : 0 Afghanistan : 0 1st Qu.:1998 1st Qu.:10.47
## AC : 0 Albania : 0 Median :2015 Median :18.87
## AE : 0 Algeria : 0 Mean :2015 Mean :27.00
## AF : 0 American Samoa: 0 3rd Qu.:2032 3rd Qu.:41.30
## AG : 0 Andorra : 0 Max. :2050 Max. :72.58
## (Other): 0 (Other) : 0
## infant_mortality_male infant_mortality_female life_expectancy
## Min. : 7.18 Min. : 6.050 Min. :62.61
## 1st Qu.:11.31 1st Qu.: 9.585 1st Qu.:68.73
## Median :20.13 Median :17.550 Median :74.57
## Mean :28.48 Mean :25.455 Mean :73.34
## 3rd Qu.:42.60 3rd Qu.:39.950 3rd Qu.:78.09
## Max. :77.81 Max. :67.090 Max. :80.60
##
## life_expectancy_male life_expectancy_female mortality_rate_under5
## Min. :60.86 Min. :64.45 Min. : 7.47
## 1st Qu.:67.02 1st Qu.:70.52 1st Qu.:11.85
## Median :72.26 Median :77.00 Median :21.51
## Mean :71.14 Mean :75.64 Mean :31.74
## 3rd Qu.:75.54 3rd Qu.:80.78 3rd Qu.:48.09
## Max. :77.89 Max. :83.44 Max. :90.23
##
## mortality_rate_under5_male mortality_rate_under5_female
## Min. : 8.05 Min. : 6.85
## 1st Qu.:12.70 1st Qu.:10.96
## Median :22.61 Median :20.36
## Mean :32.99 Mean :30.42
## 3rd Qu.:48.81 3rd Qu.:47.34
## Max. :95.08 Max. :85.14
##
## mortality_rate_1to4 mortality_rate_1to4_male mortality_rate_1to4_female
## Min. : 0.840 Min. : 0.880 Min. : 0.800
## 1st Qu.: 1.395 1st Qu.: 1.400 1st Qu.: 1.390
## Median : 2.690 Median : 2.530 Median : 2.860
## Mean : 4.963 Mean : 4.745 Mean : 5.191
## 3rd Qu.: 7.075 3rd Qu.: 6.480 3rd Qu.: 7.695
## Max. :19.030 Max. :18.730 Max. :19.350
##
#Life expectancy of 1970/2000/2017/2050
target2 <- c("1970", "2000", "2017", "2050")
years_chosen2 <- filter(mortality, year %in% target2)
qplot(x = life_expectancy, y = year, data = years_chosen2)
mydata<-read.csv(file="midyear_population.csv", header=TRUE)
data17<-mydata%>%
filter(year=="2017")%>%
group_by(country_name,per_area,latitude,longitude)
data1950<-mydata%>%
filter(year=="1950")%>%
group_by(country_name,per_area,latitude,longitude)
data2050<-mydata%>%
filter(year=="2050")%>%
group_by(country_name,per_area,latitude,longitude)
m=map("world", fill = TRUE, plot = FALSE)
m_nms <- sapply( strsplit( m$names, ':' ), function(x) x[1] )
m_poli <- map2SpatialPolygons(m, IDs=m_nms, proj4string=CRS("+proj=longlat +datum=WGS84"))
m_df <- data.frame(ID = names(m_poli))
rownames(m_df) <- names(m_poli)
world_spdf <- SpatialPolygonsDataFrame(m_poli, m_df)
birlestirme17<- merge(world_spdf, data17, by.x = 'ID', by.y = 'country_name')
birlestirme1950<- merge(world_spdf, data1950, by.x = 'ID', by.y = 'country_name')
birlestirme2050<- merge(world_spdf, data2050, by.x = 'ID', by.y = 'country_name')
bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal1<- colorBin("YlOrRd", domain = birlestirme1950$per_area, bins = bins)
pal2<- colorBin("YlOrRd", domain = birlestirme17$per_area, bins = bins)
pal3<- colorBin("YlOrRd", domain = birlestirme2050$per_area, bins = bins)
#alternative for continious coloring
#qpal <- colorQuantile("Blues", data17$per_area, n = 9)
labels1<- sprintf(
"<strong>%s</strong><br/>%g people / km<sup>2</sup>",
birlestirme1950$ID, birlestirme1950$per_area
) %>% lapply(htmltools::HTML)
labels2<- sprintf(
"<strong>%s</strong><br/>%g people / km<sup>2</sup>",
birlestirme17$ID, birlestirme17$per_area
) %>% lapply(htmltools::HTML)
labels3<- sprintf(
"<strong>%s</strong><br/>%g people / km<sup>2</sup>",
birlestirme2050$ID, birlestirme2050$per_area
) %>% lapply(htmltools::HTML)
leaflet(data = birlestirme1950) %>% addTiles() %>%
setView(lat = 39, lng = 35, zoom = 1) %>%
addPolygons(color = "#444444",
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
fillColor = ~pal1(birlestirme1950$per_area),
highlightOptions = highlightOptions(color = "white", weight = 2,bringToFront = TRUE),
label=labels1,
labelOptions=labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend("bottomright", pal=pal1, values = ~birlestirme1950$per_area,
title = "per area",
labFormat = labelFormat(digits=5),
opacity = 1)
leaflet(data = birlestirme17) %>% addTiles() %>%
setView(lat = 39, lng = 35, zoom = 1) %>%
addPolygons(color = "#444444",
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
fillColor = ~pal2(birlestirme17$per_area),
highlightOptions = highlightOptions(color = "white", weight = 2,bringToFront = TRUE),
label=labels2,
labelOptions=labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend("bottomright", pal=pal2, values = ~birlestirme17$per_area,
title = "per area",
labFormat = labelFormat(digits=5),
opacity = 1)
leaflet(data = birlestirme2050) %>% addTiles() %>%
setView(lat = 39, lng = 35, zoom = 1) %>%
addPolygons(color = "#444444",
weight = 1,
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 0.5,
fillColor = ~pal3(birlestirme2050$per_area),
highlightOptions = highlightOptions(color = "white", weight = 2,bringToFront = TRUE),
label=labels3,
labelOptions=labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend("bottomright", pal=pal3, values = ~birlestirme2050$per_area,
title = "per area",
labFormat = labelFormat(digits=5),
opacity = 1)